home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 17 / CU Amiga Magazine's Super CD-ROM 17 (1997)(EMAP Images)(GB)[!][issue 1997-12].iso / CUCD / Online / News / Thor / HD-Install / thor.lha / rexx / BBSRead / SaveMessage.br < prev    next >
Text File  |  1997-08-29  |  10KB  |  392 lines
  1. /*
  2. ** $VER: SaveMessage.br 1.01 (13.5.97)
  3. ** by Eirik Nicolai Synnes
  4. **
  5. ** See SortMail.guide for documentation
  6. **
  7. */
  8.  
  9. options results
  10. options failat 31
  11.  
  12. parse arg arguments
  13.  
  14. /*
  15. ** Initialize some variables
  16. */
  17.  
  18. version  = subword(sourceline(2), 4, 1)
  19.  
  20. template = 'SYSTEM/A,CONFERENCE/A,MSGNO/A/N,FILENAME/K,DIRECTORY/K,SUBSTITUTE/K,WITH/K,HEADER/S,APPEND/S,NOBIN/S'
  21.  
  22. globals  = 'args. data. head. text. fileopen filemode destname destfile downloadpath BBSREAD.LASTERROR myerr globals'
  23.  
  24. fileopen = 0
  25.  
  26.  
  27. /*
  28. ** Find/open BBSREAD ARexx port
  29. */
  30.  
  31. if ~(show('P', 'BBSREAD')) then do
  32.     address(command)
  33.     'Run >NIL: `GetEnv THOR/THORPath`bin/LoadBBSRead'
  34.     if exists('SYS:RexxC/WaitForPort') then 'SYS:RexxC/WaitForPort BBSREAD'
  35.     else 'WaitForPort BBSREAD'
  36.     if (rc = 5) then do; say 'Could not open BBSREAD''s ARexx port.'; exit(30); end
  37.     if (rc ~= 0) then do; say 'Could not find SYS:Rexxc/WaitForPort.'; exit(30); end
  38.     end
  39.  
  40. /*
  41. ** Give template if arguments = '?'
  42. */
  43.  
  44. if arguments = '?' then do
  45.     say 'Usage: 'template
  46.     say 'SplitDigest.br is an external script for SortMail.'
  47.     exit(5)
  48.     end
  49.  
  50. address(bbsread)
  51. 'READARGS TEMPLATE "'template'" STEM 'args' CMDLINE 'arguments
  52. if (rc ~= 0) then do
  53.     say BBSREAD.LASTERROR
  54.     say 'Template: 'template
  55.     say 'SaveMessage.br is an external script for SortMail.'
  56.     exit(5)
  57.     end
  58.  
  59.  
  60. /*
  61. ** Find download path
  62. */
  63.  
  64. address(bbsread)
  65. 'GETBBSDATA "'args.SYSTEM'" STEM 'bbsdata
  66. if (rc ~= 0) then signal error
  67.  
  68. if (symbol('bbsdata.DNLOADPATH') ~= 'VAR') | (bbsdata.DNLOADPATH = '') then do
  69.     'GETGLOBALDATA 'globaldata
  70.     if (rc ~= 0) then signal error
  71.     downloadpath = globaldata.DNLOADPATH
  72.     end
  73. else downloadpath = bbsdata.DNLOADPATH
  74.  
  75. if (right(downloadpath, 1) ~= ':') & (right(downloadpath, 1) ~= '/') then downloadpath = downloadpath'/'
  76.  
  77.  
  78. /*
  79. ** Find path, filename and mode of output file
  80. */
  81.  
  82. if (symbol('args.FILENAME') = 'VAR') & (symbol('args.DIRECTORY') = 'VAR') then do
  83.     myerr = 'Both DIRECTORY/K and FILENAME/K were specified.'; rc = 20; signal error
  84.     end
  85.  
  86. if ~(symbol('args.FILENAME') = 'VAR') & ~(symbol('args.DIRECTORY') = 'VAR') then do
  87.     myerr = 'Neither DIRECTORY/K nor FILENAME/K were specified.'; rc = 20; signal error
  88.     end
  89.  
  90. if (symbol('args.FILENAME') = 'VAR') then do
  91.     destfile = args.FILENAME
  92.     if (args.APPEND) & (exists(destfile)) then filemode = 'A'
  93.     else filemode = 'W'
  94.  
  95.     destfile = args.FILENAME
  96.     end
  97.  
  98. if (symbol('args.DIRECTORY') = 'VAR') then do
  99.     'READBRMESSAGE "'args.SYSTEM'" "'args.CONFERENCE'" 'args.msgno' HEADSTEM 'head
  100.     if (rc ~= 0) then signal error
  101.  
  102.     destfile = head.SUBJECT
  103.  
  104.     if (symbol('args.SUBSTITUTE') = 'VAR') then do
  105.         if (symbol('args.WITH') = 'VAR') then do
  106.             if (index(destfile, args.SUBSTITUTE) = 0) then do
  107.                 myerr = 'Substitution string not found in subject'; rc = 20; signal error
  108.                 end
  109.             destfile = substitute(destfile, args.SUBSTITUTE, args.WITH)
  110.             end
  111.         else do; myerr = 'SUBSTITUTE/K needs WITH/K.'; rc = 20; signal error; end
  112.         end
  113.  
  114.     /* Strip unwanted characters and "Re: " from subject */
  115.     destfile = compress(destfile, '*')
  116.     destfile = compress(destfile, '#')
  117.     destfile = compress(destfile, '?')
  118.     destfile = compress(destfile, '`')
  119.     destfile = compress(destfile, '/')
  120.     destfile = compress(destfile, ':')
  121.     do while upper(left(destfile, 3)) = 'RE '
  122.         if upper(left(destfile, 3)) = 'RE ' then destfile = substr(destfile, 4)
  123.         end
  124.  
  125.     if right(destname, 1) ~= ':' & right(destname, 1) ~= '/' then destname = destname'/'
  126.  
  127.     destfile = args.DIRECTORY || destfile
  128.  
  129.     if (args.APPEND) & (exists(destfile)) then filemode = 'A'
  130.     else filemode = 'W'
  131.     end
  132.  
  133.  
  134. /*
  135. ** See if there is a Thor ARexx port we can shanghai
  136. */
  137.  
  138. ports = show('P')
  139. do i = 1 to words(ports)
  140.     if pos(' THOR.', ports) > 0 then thorport = word(substr(ports, pos(' THOR.', ports)), 1)
  141.     end
  142.  
  143.  
  144. /*
  145. ** Save the message using Thor's SAVEMESSAGE if available, otherwise my own
  146. */
  147.  
  148. if (symbol('thorport') = 'VAR') then do
  149.     if ~(args.NOBIN) then do
  150.         'READBRMESSAGE "'args.SYSTEM'" "'args.CONFERENCE'" 'args.msgno' TEXTSTEM 'text
  151.         if rc ~= 0 then signal error
  152.         call checkbin('text', downloadpath)
  153.         end
  154.  
  155.     saveargs = ''
  156.     if ~(args.HEADER) then saveargs = saveargs' NOHEADER'
  157.     if ~(args.APPEND) then saveargs = saveargs' OVERWRITE'
  158.  
  159.     address(thorport)
  160.     'SAVEMESSAGE BBSNAME "'args.SYSTEM'" CONFNAME "'args.CONFERENCE'" MSGNR 'args.MSGNO' FILE "'destfile'" 'saveargs
  161.     if (rc ~= 0) then signal error
  162.     end
  163. else do
  164.     'READBRMESSAGE "'args.SYSTEM'" "'args.CONFERENCE'" 'args.msgno' TEXTSTEM 'text' HEADSTEM 'head
  165.     if (rc ~= 0) then signal error
  166.     call savemsg('head', 'text')
  167.     end
  168.  
  169. returned = 0; signal cleanup
  170.  
  171.  
  172. /*
  173. ** Some error detection stuff
  174. */
  175.  
  176. error:
  177. syntax:
  178.  
  179. returned = rc
  180.  
  181. select
  182.     when symbol('BBSREAD.LASTERROR') = 'VAR' then say 'Line 'sigl' returned 'returned': 'BBSREAD.LASTERROR
  183.     when symbol('myerr') = 'VAR' then say 'Line 'sigl' returned 'returned': 'myerr
  184.     otherwise say 'Line 'sigl' returned 'returned': 'errortext(returned)
  185.     end
  186.  
  187.  
  188. break_c:
  189. halt:
  190. cleanup:
  191.  
  192. /*
  193. ** Close output file if open
  194. */
  195.  
  196. if (fileopen) then do
  197.     call close(of)
  198.     fileopen = 0
  199.     end
  200.  
  201. exit(returned)
  202.  
  203.  
  204.  /****************************************************************************
  205. ******************* Check if a message contains binary parts ******************
  206.  ****************************************************************************/
  207.  
  208. checkbin: interpret 'procedure expose 'globals
  209.           parse arg tstem, downloadpath
  210.  
  211. /*
  212. ** Check for message parts
  213. */
  214.  
  215. if (symbol(tstem'.PART.COUNT') = 'VAR') then do
  216.     parts = value(tstem'.PART.COUNT')
  217.  
  218.     if (parts > 0) then do i = 1 to parts
  219.         if (symbol(tstem'.PART.'i'.BINARY') = 'VAR') then do
  220.             if (exists(value(tstem'.PART.'i'.BINARY'))) then do
  221.                 address(command)
  222.                 'Copy "'value(tstem'.PART.'i'.BINARY')'" TO "'downloadpath'" CLONE QUIET'
  223.                 if (rc ~= 0) then do; myerr = 'Failed to copy binary part to download directory.'; rc = 20; signal error; end
  224.                 address(bbsread)
  225.                 end
  226.             end
  227.  
  228.         else do
  229.             usestem = tstem'.PART.'i'.MSG'
  230.             call checkbin(usestem, downloadpath)
  231.             end
  232.  
  233.         end
  234.  
  235.     end
  236.  
  237. return(0)
  238.  
  239.  
  240.  /****************************************************************************
  241. *************** Recursive procedure for writing message to file ***************
  242.  ****************************************************************************/
  243.  
  244. savemsg: interpret 'procedure expose 'globals
  245.          parse arg hstem, tstem
  246.  
  247. /*
  248. ** Open file for writing/appending
  249. */
  250.  
  251. if ~(fileopen) then do
  252.     fileopen = open(of, destfile, filemode)
  253.     if (fileopen) & (filemode = 'A') then call writeln(of, copies('=', 79))
  254.     end
  255.  
  256. if ~(fileopen) then do
  257.     myerr = 'Couldn''t open "'destfile'" for writing.'; rc = 20; signal error
  258.     end
  259.  
  260. /*
  261. ** Write to/from names/addresses, subject and header
  262. */
  263.  
  264. if (args.HEADER) then do
  265.     if (symbol(hstem.'FROMNAME') = 'VAR') then do
  266.         from = value(hstem'.FROMNAME')
  267.         if (symbol(hstem'.FROMADDR') = 'VAR') then from = from || ' <' || value(hstem'.FROMADDR') || '>'
  268.         end
  269.     else do
  270.         from = head.FROMNAME
  271.         if (symbol('head.FROMADDR') = 'VAR') then from = from || ' <' || head.FROMADDR || '>'
  272.         end
  273.     call writeln(of, 'From: 'from)
  274.  
  275.     if (symbol(hstem'.TONAME') = 'VAR') then do
  276.         to = value(hstem'.TONAME')
  277.         if (symbol(hstem'.TOADDR') = 'VAR') then to = to || ' <' || value(hstem'.TOADDR') || '>'
  278.         call writeln(of, 'To: 'to)
  279.         end
  280.  
  281.     if (symbol(hstem'.SUBJECT') = 'VAR') then call writeln(of, 'Subject: 'value(hstem'.SUBJECT'))
  282.     else call writeln(of, 'Subject: 'head.SUBJECT)
  283.  
  284.     if (symbol(tstem'.REPLYADDR') = 'VAR') then call writeln(of, 'Reply-To: 'value(tstem.'REPLYADDR'))
  285.  
  286.     if (symbol(tstem'.COMMENT.COUNT') = 'VAR') then do
  287.         cnt = value(tstem'.COMMENT.COUNT')
  288.         if cnt > 0 then do
  289.             do i = 1 to cnt; call writeln(of, value(tstem'.COMMENT.'i)); end
  290.             end
  291.         end
  292.     end
  293.  
  294. /*
  295. ** Write body text
  296. */
  297.  
  298. if (symbol(tstem'.TEXT.COUNT') = 'VAR') then do
  299.     cnt = value(tstem'.TEXT.COUNT')
  300.     if (cnt > 0) then do
  301.         call writeln(of, '')
  302.         do i = 1 to cnt; call writeln(of, value(tstem'.TEXT.'i)); end
  303.         end
  304.     end
  305.  
  306. /*
  307. ** Check for message parts
  308. */
  309.  
  310. if (symbol(tstem'.PART.COUNT') = 'VAR') then do
  311.  
  312.     parts = value(tstem'.PART.COUNT')
  313.     if (parts > 0) then do i = 1 to parts
  314.         select
  315.             when (symbol(tstem'.PART.'i'.BINARY') = 'VAR') then do
  316.                 call writeln(of, '')
  317.  
  318.                 cnt = 0
  319.                 if (symbol(tstem'.PART.'i'.BINARY.COMMENT.COUNT') = VAR) & (args.HEADER) then cnt = value(tstem'.PART.'i'.BINARY.COMMENT.COUNT')
  320.                 if (cnt > 0) then do
  321.                     call writeln(of, '')
  322.                     do j = 1 to cnt
  323.                         call writeln(of, value(tstem'.PART.'i'.BINARY.COMMENT.'j))
  324.                         end
  325.                     end
  326.  
  327.                 if (args.NOBIN) then call writeln(of, '[Binary part: 'value(tstem'.PART.'i'.BINARY')']')
  328.                 else do
  329.                     if (exists(value(tstem'.PART.'i'.BINARY'))) then do
  330.                         address(command)
  331.                         'Copy "'value(tstem'.PART.'i'.BINARY')'" TO "'downloadpath'" CLONE QUIET'
  332.                         if (rc ~= 0) then do; myerr = 'Failed to copy binary part to download directory.'; rc = 20; signal error; end
  333.                         address(bbsread)
  334.                         call writeln(of, '[Binary part "' || value(tstem'.PART.'i'.BINARY') || '" copied to "' || downloadpath || '"]')
  335.                         end
  336.                     else call writeln(of, '[Binary part "' || value(tstem'.PART.'i'.BINARY') || '" was already deleted]')
  337.                     end
  338.                 end
  339.  
  340.             when (symbol(tstem'.PART.'i'.COMMENT.COUNT') = 'VAR') & (args.HEADER) then do
  341.                 cnt = value(tstem'.PART.'i'.COMMENT.COUNT')
  342.                 if (cnt > 0) then do
  343.                     do j = 1 to cnt
  344.                         call writeln(of, value(tstem'.PART.'i'.COMMENT.'j))
  345.                         end
  346.                     end
  347.                 end
  348.  
  349.             when (symbol(tstem'.PART.'i'.TEXT.COUNT') = 'VAR') then do
  350.                 cnt = value(tstem'.PART.'i'.TEXT.COUNT')
  351.                 if (cnt > 0) then do
  352.                     call writeln(of, '')
  353.                     do j = 1 to cnt
  354.                         call writeln(of, value(tstem'.PART.'i'.TEXT.'j))
  355.                         end
  356.                     end
  357.                 end
  358.  
  359.             otherwise do
  360.                 call writeln(of, copies('=', 79))
  361.                 usestem = tstem'.PART.'i'.MSG'
  362.                 call savemsg(usestem, usestem)
  363.                 end
  364.             end
  365.         end
  366.     end
  367.  
  368. return(0)
  369.  
  370.  
  371.  /****************************************************************************
  372. ********************* Substitute a string within a string *********************
  373. ******** Shamelessly ripped from Troels Walsted Hansen's UUDecode.thor ********
  374.  ****************************************************************************/
  375.  
  376. substitute: interpret 'procedure expose 'globals
  377.             parse arg str, org, new
  378.  
  379. lastfound = 0
  380.  
  381. found = index(str, org)
  382.  
  383. do while found > lastfound
  384.     secondpart = substr(str, found + length(org))
  385.     firstpart = substr(str, 1, length(str) - length(substr(str, found)))
  386.     str = firstpart || new || secondpart
  387.     lastfound = found + length(new)
  388.     found = index(str, org, lastfound)
  389.     end
  390.  
  391. return(str)
  392.